home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / misc / guienv374.lha / GUIEnvironment / OberonA / Source / 3rdParty / GUIEnvSupport.mod < prev   
Text File  |  1994-11-01  |  3KB  |  97 lines
  1. (****************************************************************************
  2.  
  3. $RCSfile: GUIEnvSupport.mod $
  4.  
  5. $Revision: 1.4 $
  6.     $Date: 1994/09/29 17:50:19 $
  7.  
  8.     Some needful extra definitions and functions for GUIEnvironment
  9.  
  10.     Oberon-A Oberon-2 Compiler V4.17 (Release 1.4 Update 2)
  11.  
  12.   Copyright © 1994, Carsten Ziegeler
  13.                     Augustin-Wibbelt-Str.7, 33106 Paderborn, Germany
  14.  
  15. ****************************************************************************)
  16. MODULE GUIEnvSupport;
  17.  
  18. (* $P- Allow non-portable code *)
  19.  
  20. IMPORT SYS := SYSTEM,
  21.        E := Exec,
  22.        GT:= GadTools,
  23.        G := Graphics,
  24.        I := Intuition,
  25.        S := Strings,
  26.        U := Utility,
  27.  
  28.        GUI := GUIEnv;
  29.  
  30. VAR topazfont : G.TextAttr;
  31.  
  32. CONST
  33.  
  34. (* -------------- screen support: displayIDs ----------------------------- *)
  35.  
  36.   gesHiresPalID  * = G.hiresKey + G.palMonitorID;
  37.   gesHiresID     * = G.hiresKey + G.defaultMonitorID;
  38.   gesLoresPalID  * = G.loresKey + G.palMonitorID;
  39.   gesLoresID     * = G.loresKey + G.defaultMonitorID;
  40.  
  41.  
  42. (* -------------------------- tag data support --------------------------- *)
  43.  
  44.   gegShiftLeft   * = 256*256*256;
  45.   gegShiftTop    * = 256*256;
  46.   gegShiftWidth  * = 256;
  47.   gegShiftHeight * = 1;
  48.  
  49.   PROCEDURE GADDESC * (left, top, width, height : INTEGER) : LONGINT;
  50.   BEGIN
  51.     RETURN gegShiftLeft * left + gegShiftTop * top + gegShiftWidth * width + gegShiftHeight * height;
  52.   END GADDESC;
  53.  
  54.   PROCEDURE GADOBJS * (left, top, width, height : INTEGER) : LONGINT;
  55.   BEGIN
  56.     RETURN gegShiftLeft * left + gegShiftTop * top + gegShiftWidth * width + gegShiftHeight * height;
  57.   END GADOBJS;
  58.  
  59. (* ------------------------------- Font support ------------------------- *)
  60.  
  61.   PROCEDURE TopazAttr * ():G.TextAttrPtr;
  62.   BEGIN
  63.     topazfont.name := SYS.ADR("topaz.font");
  64.     topazfont.ySize:= 8;
  65.     RETURN SYS.ADR(topazfont);
  66.   END TopazAttr;
  67.  
  68. (* ---------------------------- Hook functions -------------------------- *)
  69.  
  70.   PROCEDURE GEUpdateEntryGadgetAHook * (hook   : U.HookPtr;
  71.                                         gadget : I.GadgetPtr;
  72.                                         unused : E.APTR) : LONGINT;
  73.   TYPE LINTPTR = CPOINTER TO LONGINT;
  74.   VAR GINFO : GUI.GUIGadgetInfoPtr;
  75.       val   : LINTPTR;
  76.       vas   : E.STRPTR;
  77.       info  : I.StringInfoPtr;
  78.   BEGIN
  79.     GINFO := SYS.VAL(GUI.GUIGadgetInfoPtr, gadget^.userData);
  80.     vas := SYS.VAL(E.STRPTR, GUI.base.GetGUIGadget(hook^.data, gadget^.gadgetID, GUI.gegVarAddress));
  81.     IF vas # NIL THEN
  82.       info := SYS.VAL(I.StringInfoPtr, gadget^.specialInfo);
  83.       CASE GINFO^.kind OF
  84.         GT.integerKind : val  := SYS.VAL(LINTPTR, vas);
  85.                          val^ := info^.longInt;
  86.                          RETURN 1;
  87.       | GT.stringKind  : vas^[0] := 0X;
  88.                          S.Insert(vas^, info^.buffer^, 0);
  89.                          RETURN 1;
  90.       ELSE
  91.       END;
  92.     END;
  93.     RETURN 0;
  94.   END GEUpdateEntryGadgetAHook;
  95.  
  96. END GUIEnvSupport.
  97.